home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / MacPerl ƒ / Perl Source ƒ / Perl / Distribute < prev    next >
Text File  |  1993-10-25  |  3KB  |  121 lines
  1. Set DistFolder `Perl -Sx "{0}" "{1}" "{TempFolder}"Distribute.Dup`     &&    ∂
  2.     "{TempFolder}"Distribute.Dup                                                    &&    ∂
  3.     Stuff -r "{DistFolder}" -o "{2}"                                                &&    ∂
  4.     Delete -y "{DistFolder}" "{TempFolder}"Distribute.Dup
  5. Exit
  6.  
  7. #!perl
  8. #######################################################################
  9. #    Project    :    Distr                -    
  10. #    File        :    Distribute        -    Build a distribution
  11. #    Author    :    Matthias Neeracher
  12. #    Started    :    29Jun93                                Language    :    MPW Perl
  13. #    Modified    :    31Jul93    MN    Some unpleasant bugs
  14. #    Last        :    31Jul93
  15. #######################################################################
  16.  
  17. ($distfile,$dup) = @ARGV;
  18.  
  19. open(DIST, $distfile) || die "$0: Could not open \"$distfile\"";
  20. open(DUP, ">$dup") || die "$0: Could not open \"$dup\"";
  21.  
  22. print DUP "Echo #\n";
  23.  
  24. while (<DIST>) {
  25.     next if /^\s*$/;
  26.     next if /^\s*#/;
  27.     
  28.     undef $atx,$aty;
  29.     
  30.     if (/(.*)AT\s+(\d+)\s*,\s*(\d+)(.*)/) {
  31.         ($atx,$aty,$_) = ($2, $3, $1 . $4);
  32.     }
  33.     
  34.     if (/^\s*TARGET\s+\"([^"]+)\"\s*$/ || /^\s*TARGET\s+(\S+)\s*$/) {
  35.         $target = $1;
  36.         $target = ":$target" unless ($target =~ /^:/);
  37.         $target = "$target:" unless ($target =~ /:$/);
  38.             
  39.         &mkdirs($target);
  40.         
  41.         # print DUP "SetFile \'$target\' -l $atx,$aty\n" if (defined $atx);
  42.     } elsif (    /^\s*\"([^"]+)\"\s+AS\s+\"([^"]+)\"\s*$/
  43.                 || /^\s*\"([^"]+)\"\s+AS\s+(\S+)\s*$/    
  44.                 || /^\s*(\S+)\s+AS\s+(\S+)\s*$/ 
  45.     ) {
  46.         &linkfile($1, "$target$2", 0);
  47.     } elsif (/^\s*\"([^"]+)\"\s*$/ || /^\s*(\S+)\s*$/) {
  48.         &linkfiles($1, $target);
  49.     } else {
  50.         print STDERR "File \"$distfile\"; Line $. # Syntax Error\n";
  51.     }
  52. }
  53.  
  54. $target =~ /^:?([^:]+)/;
  55.  
  56. print "\"$1\"\n";
  57.  
  58. sub mkdirs 
  59. {
  60.     local($dir) = @_;
  61.     
  62.     if (!-d $dir) {
  63.         if ($dir =~ /(.*:)[^:]+:/) {
  64.             &mkdirs($1);
  65.         }
  66.         
  67.         mkdir($dir, 0777) || die "Couldn't create directory \"$dir\"";
  68.     }
  69. }
  70.  
  71. sub linkfile
  72. {
  73.     local($from,$to,$linkem) = @_;
  74.  
  75.     print STDERR "\t\t\t$from -> $to\n";
  76.     
  77.     if ($to =~ /(.*):Icon∂n$/) {
  78.         print DUP "SetFile -a C \'$1\'\n";
  79.     }
  80.     
  81.     $from =~ s/∂n/\n/g;
  82.     $to =~ s/∂n/\n/g;
  83.     
  84.     unlink $to if (-e $to);
  85.     
  86.     if ($linkem) {
  87.         symlink($from, $to) || die "Couldn't link \"$from\" to \"$to\"";
  88.     } else {
  89.         print DUP "Duplicate \'$from\' \'$to\'\n";
  90.     }
  91.         
  92.     # print DUP "SetFile -noResolve \'$to\' -l $atx,$aty\n" if (defined $atx);
  93. }
  94.  
  95. sub linkfiles
  96. {
  97.     local($from,$target) = @_;
  98.     
  99.     if ($from =~ /^(.*):([^:]+)$/) {
  100.         ($fromdir,$fromfile) = ($1,$2);
  101.     } else {
  102.         ($fromdir,$fromfile) = (":",$from);
  103.     }
  104.     
  105.     if ($fromfile =~ /[≈?]/) {
  106.         $fromfile =~ s/\./\\./;
  107.         $fromfile =~ s/≈/.*/;
  108.         $fromfile =~ s/\?/./;
  109.         
  110.         opendir(FROMDIR, $fromdir) || "Could not open \"$fromdir\"";
  111.         
  112.         while ($from = readdir(FROMDIR)) {
  113.             next unless $from =~ /^$fromfile$/;
  114.             
  115.             &linkfile("$fromdir:$from", "$target$from", 1);
  116.         }
  117.     } else {
  118.         &linkfile($from,"$target$fromfile", 1);
  119.     }
  120. }
  121.